00100	TITLE LS - LOCUS SOLVERS - BGB - MARCH 1973.
00200	
00300	;CRE NODE FORMATS.
00400	;----------------------------------------------------------------;
00500	;								 ;
00600	;       VERTEX/ARC NODE.	POLYGON/REGION NODE.		 ;
00700	;								 ;
00800	;	0   CW,,CCW  		0   polygon-ring.		 ;
00900	; 	1   ROW,,COL		1   DAD,,SON  			 ;
01000	;	2   TYPE,,RELOC		2   TYPE,,RELOC			 ;
01100	;	3   ENDO,,EXO		3   ENDO,,EXO			 ;
01200	;	4   ARC,,PED		4   ARC,,NCNT          		 ;
01300	;	5   CNTRST,,PGON	5   CIS,,PGON			 ;
01400	;	6   NTIME,,PTIME	6   NTIME,,PTIME		 ;
01500	;								 ;
01600	;----------------------------------------------------------------;
01700	;   	WINGED EDGE NODE.       FACE NODE.			 ;
01800	;								 ;
01900	;	0   NCW ,,PCW		0    - ,, -			 ;
02000	; 	1   NCCW,,PCCW		1   DAD,, -  			 ;
02100	;	2   TYPE,,lngth/cntrst	2   TYPE,,RELOC			 ;
02200	;	3   NFACE,,PFACE	3   NFACE,,PFACE		 ;
02300	;	4   NED,,PED		4    - ,,PED			 ;
02400	;	5   NVT,,PVT		5    - ,, -			 ;
02500	;	6   NTIME,,PTIME	6   NTIME,,PTIME		 ;
02600	;								 ;
02700	;----------------------------------------------------------------;
02800	;       IMAGE NODE.             LEVEL NODE.			 ;
02900	;								 ;
03000	;	0   image-ring.		0    level-ring.		 ;
03100	; 	1    - ,,SON  		1    - ,,SON 			 ;
03200	;	2   TYPE,,RELOC		2   TYPE,,RELOC			 ;
03300	;	3   NFACE,,PFACE	3    - ,, -    			 ;
03400	;	4   NED,,PED		4    - ,,NCNT 			 ;
03500	;	5    - ,, - 		5    - ,, -			 ;
03600	;	6   NTIME,,PTIME	6   NTIME,,PTIME		 ;
03700	;								 ;
03800	;----------------------------------------------------------------;
03900	;       FILM NODE.              EMPTY NODE.			 ;
04000	;								 ;
04100	;	0   coresize 		0    - ,,avail			 ;
04200	; 	1    - ,,SON  		1    - ,, -			 ;
04300	;	2   TYPE,,RELOC		2   TYPE,,RELOC			 ;
04400	;	3    - ,,avail  	3    - ,, -    			 ;
04500	;	4   blk count		4    - ,, - 			 ;
04600	;	5    - ,, - 		5    - ,, -			 ;
04700	;	6   NTIME,,PTIME	6   NTIME,,PTIME		 ;
04800	;								 ;
04900	;----------------------------------------------------------------;
     

00100	;DEFINE CRE LINK NAMES.
00200	
00300		%←←1B18
00400		DEFINE LEFT $(NAM,WRD){
00500		DEFINE NAM(A,Q)<CAR A,%+WRD(Q)>
00600		DEFINE NAM$.(A,Q)<DIP A,%+WRD(Q)>}
00700	
00800		DEFINE RIGHT $(NAM,WRD){
00900		DEFINE NAM(A,Q)<CDR A,%+WRD(Q)>
01000		DEFINE NAM$.(A,Q)<DAP A,%+WRD(Q)>}
01100	
01200		LEFT(%DAD,1)↔RIGHT(%SON,1)
01300		LEFT(%TYP,2)↔RIGHT(%ALT,2)
01400		LEFT(%ROW,1)↔RIGHT(%COL,1)
01500		LEFT(%CW, 0)↔RIGHT(%CCW,0)
01600		LEFT(%NCW,0)↔RIGHT(%PCW,0)
01700		LEFT(%NCCW,1)↔RIGHT(%PCCW,1)
01800		LEFT(%NFAC,3)↔RIGHT(%PFAC,3)
01900		LEFT(%NED,4)↔RIGHT(%PED,4)
02000		LEFT(%NVT,5)↔RIGHT(%PVT,5)
02100		LEFT(%NTIM,6)↔RIGHT(%PTIM,6)
02200		LEFT(%ENDO,3)↔RIGHT(%EXO,3)
02300		LEFT(%NGON,5)↔RIGHT(%PGON,5)
02350		LEFT(%ARC,4)
02400	
02500	;-----------------------------------------------------------------
     

00100	SUBR(MKIMGS)------------------------------------------------------
00200	BEGIN MKIMGS; MAKE GEOMED IMAGES FROM CRE IMAGES.
00300		EXTERN MKNODE,BATT,MKB,MKF,MKV,MKEV,MKFE,UNIVERSE
00400		ACCUMULATORS{A,B,C}
00500	
00600		SKIPN A,%+1↔POP0J
00700		DAC A,%IMG↔DAC A,%IMG0		;FIRST CRE IMAGE OF FILM.
00800		
00900	;MAKE A GEOMED IMAGE.
01000	L4:	SETQ(IMG,{MKNODE,[PBIT+$IMAGE]})
01100		CW. 1,1↔CCW. 1,1		;EMPTY BODY RING.
01200		CALL(BATT,IMG,UNIVERSE)		;PLACE IMAGE IN UNIVERSE.
01300	
01400		LAC A,%IMG↔%SON A,A
01500		DAC A,%LEV↔DAC A,%LEV0		;FIRST LEVEL OF IMAGE.
01600	
01700	L3:	LAC A,%LEV↔%SON A,A
01800		DAC A,%PGN↔DAC A,%PGN0		;FIRST POLYGON OF LEVEL.
01900	
02000	L2:	LAC A,%PGN↔%ARC A,A
02100		DAC A,%V↔DAC A,%V0		;FIRST VERTEX OF POLYGON.
02200	
02300		SETQ(BDY,{MKB,IMG})
02400		SETQ(FACE,{MKF,BDY})
02500		SETQ(V0,{MKV,BDY})↔DAC 1,V
02600	
02700	L1:	LAC 2,%V
02800		%ROW 0,2↔FLO↔FSB[108.0]↔DACN YPP(1)
02900		%COL 0,2↔FLO↔FSB[144.0]↔DAC  XPP(1)
03000	
03100		%CCW 2,2↔DAC 2,%V			;NEXT VECTOR.
03200		CAME 2,%V0↔GO[
03300		SETQ(V,{MKEV,FACE,V})↔GO L1]
03400		CALL(MKFE,V,FACE,V0)
03500		
03600		LAC 1,%PGN↔%CCW 1,1↔DAC 1,%PGN		;NEXT POLYGON.
03700		CAME 1,%PGN0↔GO L2
03800		LAC 1,%LEV↔%CCW 1,1↔DAC 1,%LEV		;NEXT LEVEL.
03900		CAME 1,%LEV0↔GO L3
04000		LAC 1,%IMG↔%CCW 1,1↔DAC 1,%IMG		;NEXT IMAGE.
04100		CAME 1,%IMG0↔GO L4↔POP0J
04200	
04300	DECLARE{BDY,FACE,V,V0,%V,%V0,%PGN,%PGN0,%LEV,%LEV0,IMG,%IMG,%IMG0}
04400	BEND MKIMGS; BGB 14 MARCH 1973 -----------------------------------
04500	END